home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / PNL010.ARJ / READINI.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-01  |  10KB  |  399 lines
  1. Unit ReadIni;
  2. (*Copyright (c) 1992 KHIRON Software
  3.  
  4.   All rights reserved. KHIRON Software hereby grants
  5.   permission for free distribution of this software,
  6.   and for use of this software within commercial and
  7.   non-commercial applications. This software itself
  8.   may not be distributed commercially without obtaining
  9.   written permission from KHIRON Software.
  10.  
  11.   Should you use this software or it's techniques in commercial
  12.   products send me a postcard at the following address to fulfill
  13.   a licensing commitment:
  14.  
  15.     Richard A. Morris
  16.     C/- KHIRON Software
  17.     P.O. Box 544
  18.     INDOOROOPILLY Qld 4068
  19.     AUSTRALIA
  20. *)
  21. (* A Demonstration of a usefull Collection.
  22.   This unit once inserted in a Uses statement in your program
  23.   will read a Windows style ini file, and store in Dynamic memory
  24.   a collection of startup parameters.  This unit provides you access
  25.   functions to query the collection;
  26.  
  27.   Format of INI File {Name - Filename.INI wher Filename is Path/Name of your App}
  28.   ~~~~~~~~~~~~~
  29.   ;Comment
  30.   [TAG]
  31.     PARAM=VALUE
  32.   ~~~~~~~~~~~~~
  33.   eg:
  34.   ~~~~~~~~~~~~~~~~~~~~~
  35.   [System]
  36.     DataDir=C:\Data\
  37.   [ScreenMode]
  38.   ; Name=Mode,Xres,Yres
  39.   B&W_80x25=2,80,25
  40.   Colour_80x25=3,80,25
  41.   Mono_80x25=7,80,25
  42.   ~~~~~~~~~~~~~~~~~~~~~
  43.   (all items case insensitive, white space neutral)
  44.  
  45. Interface Functions
  46.   GETPARAM(TAG,PARAM) : VALUE
  47.     Return the Value for Param in the group TAG
  48.      ie: GETPARAM('SYSTEM','DATADIR') will return 'C:\DATA\'
  49.   ParamsFor(TAG) : Number
  50.     Return the number of Param
  51.      ie: PARAMS(ScreenMode) will return 3
  52.   PItem(TAG,INDEX) : String
  53.     Return the PARAMLine for item INDEX of group TAG
  54.      ie: PItem('SCREENMODE',2) will return 'Colour_80x25=3,80,25'
  55.   VarParam(String) : Longint;
  56.     Encapsulation of System.Val
  57.   ParamNum(PARAMLINE,INDEX) : String
  58.     Return the INDEXth item from a comma delimited PARAMLINE
  59.      ie: ParamNum('Colour_80x25=3,80,25',1) will return '3'
  60. *)
  61. {$O+,F+}
  62. INTERFACE
  63.   Uses Objects,
  64.        Dos;
  65. Function GetParam(Tag : String;
  66.                   Param : String) : String;
  67. Function ParamsFor(Tag : String) : Byte;
  68. Function PItem(TAG : String;
  69.                Ind : Byte) : String;
  70. Function VarParam(S : String) : Longint;
  71. Function ParamNum(S : String;
  72.                   I : Integer) : String;
  73. Type
  74.   pParamItem = ^tParamItem;
  75.   tParamItem = Object(TObject)
  76.     Param : pString;
  77.     Vars  : pString;
  78.     Constructor Init(S : String);
  79.     Destructor Done;virtual;
  80.   end;
  81.   pParamCollection = ^tParamCollection;
  82.   tParamCollection = Object(tCollection)
  83.     Tag : pString;
  84.     Constructor Init(T : String);
  85.     Destructor Done;virtual;
  86.     Function FindParam(Param : String) : String;
  87.     Procedure AddParam(S : String);
  88.   end;
  89.   pTagCollection = ^tTagCollection;
  90.   tTagCollection = Object(tCollection)
  91.     CurrentTag : pParamCollection;
  92.     Constructor Init(F : FNameStr);
  93.     Function FindTag(Tag : String) : pParamCollection;
  94.     Procedure SelectTag( T : String);
  95.   end;
  96. IMPLEMENTATION
  97. Var
  98.   Parameters     : pTagCollection;
  99.   Pre_Param_Exit : Pointer;
  100.  
  101. Function Trim(S : String) : String;
  102. Var B : Byte;
  103. begin
  104.   While S[1] = ' ' do
  105.     System.Delete(S,1,1);
  106.   While S[Length(S)] = ' ' do
  107.     System.Delete(S,Length(S),1);
  108.   For B := 1 to Length(S) do
  109.     S[B]:= UpCase(S[B]);
  110.   Trim := S;
  111. end;
  112. (***************** Interface Functions ******************)
  113. Function GetParam(Tag   : String;
  114.                   Param : String) : String;
  115. Var
  116.   P : pParamCollection;
  117. begin
  118.   Tag := Trim(Tag);
  119.   Param := Trim(Param);
  120.   P := Parameters^.FindTag(TAG);
  121.   If P = nil then
  122.     GetParam := ''
  123.   Else
  124.     GetParam := P^.FindParam(Param);
  125. end;
  126. Function VarParam(S : String) : Longint;
  127. Var
  128.   L : Longint;
  129.   I : Integer;
  130. begin
  131.   Val(S,L,I);
  132.   VarParam := L;
  133. end;
  134. Function ParamNum(S : String;
  135.                   I : Integer) : String;
  136. Var
  137.   C : Integer;
  138.   R : String;
  139.   Start,
  140.   Fini : Integer;
  141.   Function PosOf(I:Byte) : Byte;
  142.   Var
  143.     B : Byte;
  144.     N : Byte;
  145.   begin
  146.     N := 0;
  147.     For B := 1 to Length(S) do
  148.     begin
  149.       If S[B] = ',' then
  150.         inc(N);
  151.       If N = I then
  152.       begin
  153.         PosOf := B;
  154.         Exit;
  155.       end;
  156.     end;
  157.     PosOf := 0;
  158.   end;
  159. begin  {Find Parameter Number I}
  160.   S := ','+Trim(S)+',';
  161.   If PosOf(I) = 0 then
  162.     ParamNum := ''
  163.   else
  164.   begin
  165.     {Find String between Comma I and I+1}
  166.     Start := PosOf(I);
  167.     Fini := PosOf(I+1);
  168.     If Fini = 0 then
  169.       ParamNum := ''
  170.     else
  171.       ParamNum := Trim(Copy(S,Start+1,Fini-Start-1));
  172.   end;
  173. end;
  174. Function ParamsFor(Tag : String) : Byte;
  175. Var
  176.   P : pParamCollection;
  177. begin
  178.   Tag := Trim(Tag);
  179.   P := Parameters^.FindTag(TAG);
  180.   If P = nil then
  181.     ParamsFor := 0
  182.   else
  183.     ParamsFor := P^.Count;
  184. end;
  185. Function PItem(TAG : String;
  186.                Ind : Byte) : String;
  187. Var
  188.   P : pParamCollection;
  189. begin
  190.   Tag := Trim(Tag);
  191.   P := Parameters^.FindTag(TAG);
  192.   If P = nil then
  193.     PItem := ''
  194.   else
  195.     If (Ind > P^.Count) OR
  196.        (Ind <=0) then
  197.       PItem := ''
  198.     else
  199.       PItem := pparamItem(P^.AT(Ind-1))^.Param^;
  200. end;
  201. (***************************************************)
  202. Constructor tParamItem.Init(S : String);
  203. Var
  204.   T : String;
  205. begin
  206.   TObject.Init;
  207.   If Pos('=',S) <> 0 then
  208.   begin
  209.     T := Copy(S,1,Pos('=',S)-1);
  210.     System.Delete(S,1,Pos('=',S));
  211.   end;
  212.   If T = '' then
  213.     T := 'DEFAULT';
  214.   Param := NewStr(T);
  215.   Vars := NewStr(S);
  216. end;
  217. Destructor tParamItem.Done;
  218. begin
  219.   disposeStr(Param);
  220.   disposeStr(Vars);
  221.   TObject.Done;
  222. end;
  223. (***************************************************)
  224. Constructor tParamCollection.Init(T : String);
  225. begin
  226.   TCollection.Init(10,10);
  227.   Tag := NewStr(T);
  228. end;
  229. Destructor tParamCollection.Done;
  230. begin
  231.   disposeStr(Tag);
  232.   TCollection.Done;
  233. end;
  234. Function tParamCollection.FindParam(Param : String) : String;
  235. Var
  236.   I : Integer;
  237.   P : PParamItem;
  238. begin   {Search for PARAM in collection return VALUE Line}
  239.   P := nil;
  240.   For I := 0 to Count-1 do
  241.     If pParamItem(At(I))^.Param^ = Param then
  242.       P := pParamItem(At(I));
  243.   If P = nil then
  244.     FindParam := ''
  245.   else
  246.     FindParam := P^.Vars^;
  247. end;
  248. Procedure tParamCollection.AddParam(S : String);
  249. Var
  250.   I : Integer;
  251.   P : PParamItem;
  252.   T : String;
  253. begin  {Add the Parameter S to this Tag Collection}
  254.   P := nil;
  255.   If Pos('=',S) <> 0 then
  256.   begin {Separate everything BEFORE and AFTER the Equals}
  257.     T := Copy(S,1,Pos('=',S)-1);
  258.   end;
  259.   If T = '' then
  260.     T := 'DEFAULT';
  261.   For I := 0 to Count-1 do
  262.     If pParamItem(At(I))^.Param^ = T then
  263.       P := pParamItem(At(I));
  264.   If P <> nil then
  265.     Delete(P);
  266.   TCollection.Insert(New(pParamItem,Init(S)));
  267. end;
  268. (***************************************************)
  269. Constructor tTagCollection.Init(F : FNameStr);
  270. Var
  271.   T : Text;
  272.   S : String;
  273.   CurrPath : PathStr;
  274.   D : DirStr;
  275.   E : ExtStr;
  276.   N : NameStr;
  277.   OMD : Byte;
  278.   Procedure TrimLead(Var S : String);
  279.   begin  {Trim Leading blanks from a string}
  280.     While S[1] = ' ' do
  281.       System.Delete(S,1,1);
  282.   end;
  283.   Procedure TrimTrail(Var S : String);
  284.   begin  {Trim trailing blanks from a String}
  285.     While S[Length(S)] = ' ' do
  286.       System.Delete(S,Length(S),1);
  287.   end;
  288.   Procedure Upper(Var S : String);
  289.   Var B : Byte;
  290.   begin {Convert a string to uppercase}
  291.     For B := 1 to Length(S) do
  292.       S[B]:= UpCase(S[B]);
  293.   end;
  294. begin
  295.   TCollection.Init(10,10);
  296.   Assign(T,F);
  297.   OMD := FileMode;
  298.   FileMode := 64;  {ReadOnly/DenyNone for network sharing}
  299.   {$I-}
  300.   Reset(T);
  301.   {$I+}
  302.   FileMode := OMD;  {Reset the Old File Mode}
  303.   if IOResult <> 0 then  {File Doesn't exist - Fail and Halt}
  304.     Fail
  305.   else
  306.   begin
  307.     While Not EOF(T) do
  308.     begin
  309.       Readln(T,S);    {Read a Line}
  310.       TrimLead(S);    {Trim Leading Blanks}
  311.       if S[1] <> ';' then      {If SemiColon - Comment Abort}
  312.         If S <> '' then        {If Blank Line - Abort}
  313.         begin
  314.           Upper(S);      {Uppercase it}
  315.           If S[1] = '[' then
  316.           begin  {Its a Group Tag line}
  317.             System.Delete(S,1,1); {Remove the first [}
  318.             If Pos(']',S) <> 0 then
  319.               System.Delete(S,Pos(']',S),1); {Remove the last Blank}
  320.             TrimLead(S);  {Trim leading blanks}
  321.             TrimTrail(S); {Trim trailing blanks}
  322.             SelectTag(S); {Find the TAG in the collection, insert if not there}
  323.           end
  324.           else
  325.           begin
  326.             If CurrentTag = nil then
  327.               SelectTag('SYSTEM'); {If there was no tag whack it into System group}
  328.             If CurrentTag <> nil then
  329.               CurrentTag^.AddParam(S);   {Add to Curr Tag This Line}
  330.           end;
  331.         end;
  332.     end;
  333.     Close(T);
  334.   end;
  335. end;
  336. Procedure tTagCollection.SelectTag(T : String);
  337. Var
  338.   Current : pParamCollection;
  339.   I : Integer;
  340. begin
  341.   Current := nil;
  342.   If Count <> 0 then
  343.     For I := 0 to Count-1 do
  344.       If pParamCollection(AT(I))^.TAG^ = T then
  345.         Current := pParamCollection(AT(I));
  346.   If Current = Nil then
  347.   begin
  348.     Current := new(pParamCollection,Init(T));
  349.     TCollection.Insert(Current);
  350.   end;
  351.   CurrentTag := Current;
  352. end;
  353. Function tTagCollection.FindTag(Tag : String) : pParamCollection;
  354. Var
  355.   I : Integer;
  356.   P : PParamCollection;
  357. begin   {Search for TAG}
  358.   P := nil;
  359.   For I := 0 to Count-1 do
  360.     If pParamCollection(At(I))^.TAG^ = TAg then
  361.       P := pParamCollection(At(I));
  362.   FindTag := P;
  363. end;
  364. (***************************************************)
  365. Procedure DisposeParam; far;
  366. begin
  367.   ExitProc := Pre_Param_Exit;
  368.   Dispose(Parameters,Done);
  369. end;
  370. Function ParamFileName : fNameStr;
  371. {build the INI file name from the path/filename of your app,
  372.  with the extension .INI}
  373. Var
  374.   S : String;
  375.   B : Byte;
  376.   D : DirStr;
  377.   E : ExtStr;
  378.   N : NameStr;
  379. begin
  380.   S := ParamStr(0);
  381.   If S = '' then
  382.     S := 'Dental.Exe';
  383.   FSplit(FExpand(S),D,N,E);
  384.   ParamFileName := D+N+'.INI';
  385. end;
  386.  
  387. begin
  388.    {Create Param Collection}
  389.   Parameters := New(pTagCollection,Init(ParamFileName));
  390.   if Parameters=nil then
  391.   begin {No Ini File}
  392.     Writeln('Can''t find INI file',paramFileName);
  393.     Halt(255);
  394.   end;
  395.    {Make sure that when the program is finished it disposes the Collection}
  396.   Pre_Param_Exit := ExitProc;
  397.   ExitProc := @DisposeParam;
  398. end.
  399.